home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / LWP / Protocol / data.pm < prev    next >
Encoding:
Perl POD Document  |  2008-04-11  |  1.2 KB  |  53 lines
  1. package LWP::Protocol::data;
  2.  
  3. # Implements access to data:-URLs as specified in RFC 2397
  4.  
  5. use strict;
  6. use vars qw(@ISA);
  7.  
  8. require HTTP::Response;
  9. require HTTP::Status;
  10.  
  11. require LWP::Protocol;
  12. @ISA = qw(LWP::Protocol);
  13.  
  14. use HTTP::Date qw(time2str);
  15. require LWP;  # needs version number
  16.  
  17. sub request
  18. {
  19.     my($self, $request, $proxy, $arg, $size) = @_;
  20.  
  21.     # check proxy
  22.     if (defined $proxy)
  23.     {
  24.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  25.                   'You can not proxy with data';
  26.     }
  27.  
  28.     # check method
  29.     my $method = $request->method;
  30.     unless ($method eq 'GET' || $method eq 'HEAD') {
  31.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  32.                   'Library does not allow method ' .
  33.                   "$method for 'data:' URLs";
  34.     }
  35.  
  36.     my $url = $request->url;
  37.     my $response = new HTTP::Response &HTTP::Status::RC_OK, "Document follows";
  38.  
  39.     my $media_type = $url->media_type;
  40.  
  41.     my $data = $url->data;
  42.     $response->header('Content-Type'   => $media_type,
  43.               'Content-Length' => length($data),
  44.               'Date'           => time2str(time),
  45.               'Server'         => "libwww-perl-internal/$LWP::VERSION"
  46.              );
  47.     $response->content($data) if $method ne "HEAD";
  48.  
  49.     return $response;
  50. }
  51.  
  52. 1;
  53.